home *** CD-ROM | disk | FTP | other *** search
/ Clickx 115 / Clickx 115.iso / software / tools / windows / tails-i386-0.16.iso / live / filesystem.squashfs / usr / share / tcltk / tk8.5 / panedwindow.tcl < prev    next >
Encoding:
Text File  |  2009-11-17  |  5.1 KB  |  198 lines
  1. # panedwindow.tcl --
  2. #
  3. # This file defines the default bindings for Tk panedwindow widgets and
  4. # provides procedures that help in implementing those bindings.
  5. #
  6. # RCS: @(#) $Id: panedwindow.tcl,v 1.11 2005/07/25 09:06:00 dkf Exp $
  7. #
  8.  
  9. bind Panedwindow <Button-1> { ::tk::panedwindow::MarkSash %W %x %y 1 }
  10. bind Panedwindow <Button-2> { ::tk::panedwindow::MarkSash %W %x %y 0 }
  11.  
  12. bind Panedwindow <B1-Motion> { ::tk::panedwindow::DragSash %W %x %y 1 }
  13. bind Panedwindow <B2-Motion> { ::tk::panedwindow::DragSash %W %x %y 0 }
  14.  
  15. bind Panedwindow <ButtonRelease-1> {::tk::panedwindow::ReleaseSash %W 1}
  16. bind Panedwindow <ButtonRelease-2> {::tk::panedwindow::ReleaseSash %W 0}
  17.  
  18. bind Panedwindow <Motion> { ::tk::panedwindow::Motion %W %x %y }
  19.  
  20. bind Panedwindow <Leave> { ::tk::panedwindow::Leave %W }
  21.  
  22. # Initialize namespace
  23. namespace eval ::tk::panedwindow {}
  24.  
  25. # ::tk::panedwindow::MarkSash --
  26. #
  27. #   Handle marking the correct sash for possible dragging
  28. #
  29. # Arguments:
  30. #   w        the widget
  31. #   x        widget local x coord
  32. #   y        widget local y coord
  33. #   proxy    whether this should be a proxy sash
  34. # Results:
  35. #   None
  36. #
  37. proc ::tk::panedwindow::MarkSash {w x y proxy} {
  38.     variable ::tk::Priv
  39.     if {[$w cget -opaqueresize]} {
  40.     set proxy 0
  41.     }
  42.     set what [$w identify $x $y]
  43.     if { [llength $what] == 2 } {
  44.     lassign $what index which
  45.     if {!$::tk_strictMotif || $which eq "handle"} {
  46.         if {!$proxy} {
  47.         $w sash mark $index $x $y
  48.         }
  49.         set Priv(sash) $index
  50.         lassign [$w sash coord $index] sx sy
  51.         set Priv(dx) [expr {$sx-$x}]
  52.         set Priv(dy) [expr {$sy-$y}]
  53.         # Do this to init the proxy location
  54.         DragSash $w $x $y $proxy
  55.     }
  56.     }
  57. }
  58.  
  59. # ::tk::panedwindow::DragSash --
  60. #
  61. #   Handle dragging of the correct sash
  62. #
  63. # Arguments:
  64. #   w        the widget
  65. #   x        widget local x coord
  66. #   y        widget local y coord
  67. #   proxy    whether this should be a proxy sash
  68. # Results:
  69. #   Moves sash
  70. #
  71. proc ::tk::panedwindow::DragSash {w x y proxy} {
  72.     variable ::tk::Priv
  73.     if {[$w cget -opaqueresize]} {
  74.     set proxy 0
  75.     }
  76.     if {[info exists Priv(sash)]} {
  77.     if {$proxy} {
  78.         $w proxy place [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
  79.     } else {
  80.         $w sash place $Priv(sash) \
  81.             [expr {$x+$Priv(dx)}] [expr {$y+$Priv(dy)}]
  82.     }
  83.     }
  84. }
  85.  
  86. # ::tk::panedwindow::ReleaseSash --
  87. #
  88. #   Handle releasing of the sash
  89. #
  90. # Arguments:
  91. #   w        the widget
  92. #   proxy    whether this should be a proxy sash
  93. # Results:
  94. #   Returns ...
  95. #
  96. proc ::tk::panedwindow::ReleaseSash {w proxy} {
  97.     variable ::tk::Priv
  98.     if {[$w cget -opaqueresize]} {
  99.     set proxy 0
  100.     }
  101.     if {[info exists Priv(sash)]} {
  102.     if {$proxy} {
  103.         lassign [$w proxy coord] x y
  104.         $w sash place $Priv(sash) $x $y
  105.         $w proxy forget
  106.     }
  107.     unset Priv(sash) Priv(dx) Priv(dy)
  108.     }
  109. }
  110.  
  111. # ::tk::panedwindow::Motion --
  112. #
  113. #   Handle motion on the widget.  This is used to change the cursor
  114. #   when the user moves over the sash area.
  115. #
  116. # Arguments:
  117. #   w        the widget
  118. #   x        widget local x coord
  119. #   y        widget local y coord
  120. # Results:
  121. #   May change the cursor.  Sets up a timer to verify that we are still
  122. #   over the widget.
  123. #
  124. proc ::tk::panedwindow::Motion {w x y} {
  125.     variable ::tk::Priv
  126.     set id [$w identify $x $y]
  127.     if {([llength $id] == 2) && \
  128.         (!$::tk_strictMotif || [lindex $id 1] eq "handle")} {
  129.     if {![info exists Priv($w,panecursor)]} {
  130.         set Priv($w,panecursor) [$w cget -cursor]
  131.         if {[$w cget -sashcursor] ne ""} {
  132.         $w configure -cursor [$w cget -sashcursor]
  133.         } elseif {[$w cget -orient] eq "horizontal"} {
  134.         $w configure -cursor sb_h_double_arrow
  135.         } else {
  136.         $w configure -cursor sb_v_double_arrow
  137.         }
  138.         if {[info exists Priv($w,pwAfterId)]} {
  139.         after cancel $Priv($w,pwAfterId)
  140.         }
  141.         set Priv($w,pwAfterId) [after 150 \
  142.             [list ::tk::panedwindow::Cursor $w]]
  143.     }
  144.     return
  145.     }
  146.     if {[info exists Priv($w,panecursor)]} {
  147.     $w configure -cursor $Priv($w,panecursor)
  148.     unset Priv($w,panecursor)
  149.     }
  150. }
  151.  
  152. # ::tk::panedwindow::Cursor --
  153. #
  154. #   Handles returning the normal cursor when we are no longer over the
  155. #   sash area.  This needs to be done this way, because the panedwindow
  156. #   won't see Leave events when the mouse moves from the sash to a
  157. #   paned child, although the child does receive an Enter event.
  158. #
  159. # Arguments:
  160. #   w        the widget
  161. # Results:
  162. #   May restore the default cursor, or schedule a timer to do it.
  163. #
  164. proc ::tk::panedwindow::Cursor {w} {
  165.     variable ::tk::Priv
  166.     # Make sure to check window existence in case it is destroyed.
  167.     if {[info exists Priv($w,panecursor)] && [winfo exists $w]} {
  168.     if {[winfo containing [winfo pointerx $w] [winfo pointery $w]] eq $w} {
  169.         set Priv($w,pwAfterId) [after 150 \
  170.             [list ::tk::panedwindow::Cursor $w]]
  171.     } else {
  172.         $w configure -cursor $Priv($w,panecursor)
  173.         unset Priv($w,panecursor)
  174.         if {[info exists Priv($w,pwAfterId)]} {
  175.         after cancel $Priv($w,pwAfterId)
  176.         unset Priv($w,pwAfterId)
  177.         }
  178.     }
  179.     }
  180. }
  181.  
  182. # ::tk::panedwindow::Leave --
  183. #
  184. #   Return to default cursor when leaving the pw widget.
  185. #
  186. # Arguments:
  187. #   w        the widget
  188. # Results:
  189. #   Restores the default cursor
  190. #
  191. proc ::tk::panedwindow::Leave {w} {
  192.     variable ::tk::Priv
  193.     if {[info exists Priv($w,panecursor)]} {
  194.         $w configure -cursor $Priv($w,panecursor)
  195.         unset Priv($w,panecursor)
  196.     }
  197. }
  198.